home *** CD-ROM | disk | FTP | other *** search
/ Archive Magazine CD 1995 / Archive Magazine CD 1995.iso / discs / prog_disc / volume_7 / issue_07 / basicforum / heaptest (.txt) next >
Encoding:
RISC OS BBC BASIC V Source  |  1994-02-05  |  4.7 KB  |  197 lines
  1.  >HeapTest
  2. _heap_init   :
  3.  Initialise memory heap
  4.  Globals for test program
  5. quit%   = 
  6. a%      = 0
  7. b%      = 0
  8. blk%    = 0
  9. amount$ = ""
  10. g       = 0
  11.  A simple menu to test the heap procedures
  12.  '"Slot size currently ";~_SlotSize%
  13.  "Select from..."                     
  14.  "1= fetch"'"2= return"'"3= resize"'"4= quit"
  15.   g = 
  16.  - 48
  17.        
  18.  "size to fetch: &"a$
  19.       
  20.  a$ <> "" 
  21.         a%   = 
  22. ("&" + a$)
  23. !        blk% = 
  24. _heap_get(a%)
  25.         
  26.  blk% > 0 
  27. 0          
  28.  '"Block allocated at &" + 
  29. ~blk%
  30.         
  31. 0          
  32.  '"Unable to claim enough memory"
  33.         
  34.       
  35.  "      
  36.  "block to return: &"a$
  37.       
  38.  a$ <> "" 
  39.         a% = 
  40. ("&" + a$)
  41.         b% = a%
  42.         
  43. _heap_release(a%)
  44.         
  45.  (a% = 0) 
  46. &;          
  47.  '"Block at &" + 
  48. ~b% + " has been released"
  49.         
  50. (,          
  51.  '"No block exists at &"+
  52.         
  53.       
  54. ,"      
  55.  "Block to resize: &"a$
  56. -0      
  57.  "Amount (-ve to decrease): &"amount$
  58.       
  59.  a$ <> "" 
  60.         a% = 
  61. ("&" + a$)
  62.         b% = a%
  63. 1(        
  64. _heap_resize(a%,
  65. (amount$))
  66.         
  67.  (a% > 0) 
  68. 3<          
  69.  '"Block at &" + 
  70. ~b% + " has been resized ";
  71. 45          
  72.  a% <> b% 
  73.  "(now at &"+
  74. ~a%+")" 
  75.         
  76. 68          
  77.  a% = -3 
  78.  '"No block exists at &"+
  79. 7<          
  80.  a% = -2 
  81.  '"Unable to claim enough memory"
  82. 8>          
  83.  a% = -1 
  84.  '"Block size is now 0 or negative"
  85.         
  86.       
  87.       quit% = 
  88.  quit%
  89.  -- Heap Procedures ------------------------------------------------
  90.  Global variables used:
  91.    _Heap%        Start of heap
  92.    _SlotSize%    Size of current WimpSlot
  93.    _PageSize%    Size of a memory page
  94.    _HeapEnd%     End of heap
  95. _heap_init
  96. JA_Heap% = 
  97.  heap starts just after end of allocated memory
  98.  "OS_ReadMemMapInfo" 
  99.  _PageSize%
  100.  enlarge wimpslot (1 page) and create private heap in new memory
  101. _SlotSize% = _Heap% - &8000
  102.  "Wimp_SlotSize",_SlotSize% + _PageSize%,-1 
  103.  _SlotSize%
  104. O"_HeapEnd% = _SlotSize% + &8000
  105.  _HeapEnd% <= _Heap% 
  106.  0,"Can't claim space for heap"
  107.  "OS_Heap",0,_Heap%,,_HeapEnd% - _Heap%
  108. _heap_get(size%)
  109.  maxfree%,nrpages%,oldheapend%,ptr%
  110.  Returns pointer to new memory block
  111.  -1 if claim fails due to lack of memory
  112.  "OS_Heap",1,_Heap% 
  113.  ,,maxfree%
  114.  size% > maxfree% 
  115.  largest free block is too small - try to enlarge wimpslot and heap
  116. [H  nrpages% = 1 + (size% 
  117.  _PageSize%) : 
  118.  required # pages of memory
  119.  "Wimp_SlotSize",_SlotSize% + nrpages% * _PageSize%,-1 
  120.  _SlotSize%
  121.   oldheapend% = _HeapEnd%
  122. ^&  _HeapEnd%   = _SlotSize% + &8000
  123.  "OS_Heap",5,_Heap%,,_HeapEnd% - oldheapend%
  124.  "OS_Heap",1,_Heap% 
  125.  ,,maxfree% : 
  126.  do we have enough now?
  127.  size% > maxfree% 
  128.   ptr% = -1
  129.  "OS_Heap",2,_Heap%,,size% 
  130.  ,,ptr%
  131. = ptr%
  132. _heap_release(
  133.  ptr%)
  134.  maxfree%,nrpages%,flg%
  135.  Returns  0 if block released OK
  136.  Returns -1 if operation failed (i.e. block doesn't exist)
  137.  "XOS_Heap",3,_Heap%,ptr% 
  138.  ;flg%     :
  139.  Free the block
  140.  (flg% 
  141.  1) = 0 
  142.  Block was released successfully...
  143.  "OS_Heap",1,_Heap% 
  144.  ,,maxfree% :
  145.  Get info on heap
  146.  maxfree% > _PageSize% 
  147. rC    
  148.  more than 1 page free - try to shrink heap (page by page)
  149. s0    nrpages% = 0 : 
  150.  # pages of memory freed
  151. t        
  152. u5      
  153.  "XOS_Heap",5,_Heap%,,-_PageSize% 
  154.  ;flg%
  155.       
  156.  (flg% 
  157.  1) = 0 
  158.         nrpages% += 1
  159.       
  160.  (flg% 
  161.  1) <> 0
  162.  nrpages% > 0 
  163. {6      
  164.  successfully shrunk heap - shrink WimpSlot
  165. |O      
  166.  "Wimp_SlotSize",_SlotSize% - nrpages% * _PageSize%,-1 
  167.  _SlotSize%
  168. }(      _HeapEnd% = _SlotSize% + &8000
  169. ~        
  170. ?    
  171.  "OS_Heap",5,_Heap%,,(_HeapEnd% - _Heap%) - _Heap%!12
  172.  Return 0 to signal successful release of block
  173.   ptr% = 0
  174.  Error occured trying to free the block, return -1 to signal to the
  175.  program that something went wrong (normally the program would ignore
  176.  this anyway)
  177.   ptr% = -1
  178. _heap_resize(
  179.  ptr%,change%)
  180.  flg%
  181.  Returns a new pointer to the block (it may be moved in memory). Any data
  182.  in the block will be copied to the new location if necessary.
  183.  Returns -1 if the block now has a size of 0 or less
  184.  Returns -2 if claim fails due to lack of memory
  185.  Returns -3 if block does not exist
  186.  "XOS_Heap",6,_Heap%,ptr% 
  187.  ;flg% :
  188.  Read size of block to check it exists
  189.  (flg% 
  190.  It doesn't exist..
  191.   ptr% = -3
  192.  It does, so attempt to perform resize..
  193.  "XOS_Heap",4,_Heap%,ptr%,change% 
  194.  ,,ptr%;flg%
  195.  (flg% 
  196.  ptr% = -2
  197.